{GLutil v1.0 03.01.2001 by ArrowSoft-Vlad M. PARCALABIOR}
//
//All textures are stored as RGBA8 as it is more efficient as RGB8.
//TGA textures should not be Read-Only!!
//
// Visit http://arrowsoft.ifrance.com for more programs.
// If you use this code in your progras, please give me some credit
// or mention my website.


unit GLutil;

interface
uses windows, forms;

type
     TColorRGB = packed record
               r, g, b	: BYTE;
               end;
     PColorRGB = ^TColorRGB;

     TRGBList = packed array[0..0] of TColorRGB;
     PRGBList = ^TRGBList;

     TColorRGBA = packed record
               r, g, b, a : BYTE;
               end;
     PColorRGBA = ^TColorRGBA;

     TRGBAList = packed array[0..0] of TColorRGBA;
     PRGBAList = ^TRGBAList;

     TTexture=class(tobject)
      ID, width, height:integer;
      pixels: pRGBAlist;
      constructor Load(tID:integer;filename:string);
      destructor destroy; override;
     end;

     TVoidTexture=class(tobject)
      ID, width, height:integer;
      pixels: pRGBAlist;
      constructor create(tid, twidth, theight:integer);
      destructor destroy; override;
     end;

     tResolution = record
      Width, Height, BitsPerPixel: integer;
     end;

     tFullScreen=class
      Enabled: boolean;
      Resolution: tResolution;
      Resolutions: array of tResolution;
      ResolutionsCount: integer;
      constructor Create;
      destructor Destroy; override;
      function GoFullScreen(res: tResolution; handle: HWND; hidecursor: boolean):boolean;
      procedure Restore;
      function IsResAvailable(res: tResolution):boolean;
      function MakeResolution(Width, Height, BitsPerPixel: integer):tResolution;
     private
      dm: TDEVMODE;
      RC : TRECT;
      WinHandle: HWND;
     end;

implementation
uses dialogs, sysutils, graphics, jpeg;

//~~~~~~~~~~~~~~~~~~~~~~~~~~~
// Texture management
//~~~~~~~~~~~~~~~~~~~~~~~~~~~
constructor tTexture.Load(tID:integer; filename:string);
var f:file;
    atype: array [0..3] of Byte;
    info: array [0..6] of Byte;
    actread:integer;
    fext:string;
    bmp:tbitmap; jpg:tjpegimage;
    i,j:integer;
    pixline: pRGBlist;
    pixrgba: pRGBAlist;
    r,g,b:byte;

begin
inherited create;
if not fileexists(filename) then begin messagedlg(filename+' not found',mterror,[mbabort],0); halt(1);end;
fExt:=uppercase(ExtractFileExt(filename));
ID:=tID;
if fext='.BMP' then
 begin
 bmp:=TBitmap.Create;
 bmp.HandleType:=bmDIB;
 bmp.PixelFormat:=pf24bit;
 bmp.LoadFromFile(filename);
 Width:=bmp.Width;
 Height:=bmp.Height;
 getmem(pixels,width*height*4);
 for i:=0 to height-1 do
  begin
  pixline:=bmp.ScanLine[height-1-i];
  for j:=0 to width-1 do
   begin
   r:=pixline[j].b;
   g:=pixline[j].g;
   b:=pixline[j].r;
   pixels[i*width+j].r:=r;
   pixels[i*width+j].g:=g;
   pixels[i*width+j].b:=b;
   pixels[i*width+j].a:=255;
   end;
  end;
 bmp.Free;
 end
else
 if fext='.JPG' then
  begin
  jpg:=tjpegimage.Create;
  jpg.LoadFromFile(filename);
  bmp:=TBitmap.Create;
  bmp.HandleType:=bmDIB;
  bmp.PixelFormat:=pf24bit;
  Width:=jpg.Width;
  Height:=jpg.Height;
  bmp.Width:=Width;
  bmp.Height:=Height;
  bmp.Assign(jpg);
  getmem(pixels,width*height*4);
  for i:=0 to height-1 do
   begin
   pixline:=bmp.ScanLine[height-1-i];
   for j:=0 to width-1 do
    begin
    r:=pixline[j].b;
    g:=pixline[j].g;
    b:=pixline[j].r;
    pixels[i*width+j].r:=r;
    pixels[i*width+j].g:=g;
    pixels[i*width+j].b:=b;
    pixels[i*width+j].a:=255;
    end;
   end;
  bmp.Free;
  jpg.Free;
  end
 else
  if fext='.TGA' then
   begin
   assign(f,filename);
   {$i-}
   Reset(f, 1);
   BlockRead(f, atype, 4, actread);
   if (ioresult<>0) or (actread<>4) then begin messagedlg(filename+' - unrecognized format',mterror,[mbabort],0); halt(1);end;
   Seek(f, 12);
   BlockRead(f, info, 7, actread);
   if (ioresult<>0) or (actread<>7) then begin messagedlg(filename+' - unrecognized format',mterror,[mbabort],0); halt(1);end;
   {$i+}
   if (atype[1] <> 0) or (atype[2] <> 2) then begin messagedlg(filename+' - unrecognized format',mterror,[mbabort],0); halt(1);end;
   if (info[4] <> 32) and (info[4] <> 24) then begin messagedlg(filename+' - unrecognized format',mterror,[mbabort],0); halt(1);end;

   Width:=info[0] + info[1] * 256;
   Height:=info[2] + info[3] * 256;

   if info[4]= 24 then
    begin
    getmem(pixline, width*height*3);  //RGB list
    blockread(f,pixline^,width*height*3,actread);
    if actread <> width*height*3 then
     begin
     freemem(pixline);
     messagedlg(filename+' - read error',mterror,[mbabort],0); halt(1);
     end;
    getmem(pixels, width*height*4);
    for i:=0 to width*height-1 do
     begin
     pixels[i].r:=pixline[i].g;
     pixels[i].g:=pixline[i].r;
     pixels[i].b:=pixline[i].b;
     pixels[i].a:=255;
     end;
    freemem(pixline);
    end
   else  //bpp=32
    begin
    getmem(pixrgba, width*height*4);
    blockread(f,pixrgba^,width*height*4,actread);
    if actread <> width*height*4 then
     begin
     freemem(pixrgba);
     messagedlg(filename+' - read error',mterror,[mbabort],0); halt(1);
     end;
    getmem(pixels, width*height*4);
    for i:=0 to width*height-1 do
     begin
     pixels[i].r:=pixrgba[i].g;
     pixels[i].g:=pixrgba[i].r;
     pixels[i].b:=pixrgba[i].a;
     pixels[i].a:=pixrgba[i].b;
     end;
    freemem(pixrgba);
    end;
   closefile(f);
   end;

end;

destructor TTexture.destroy;
begin
freemem(pixels);
inherited destroy;
end;

constructor tvoidtexture.create(tid, twidth, theight:integer);
begin
inherited create;
id:=tid;
width:=twidth; height:=theight;
getmem(pixels,width*height*4);
end;

destructor tvoidtexture.destroy;
begin
freemem(pixels);
inherited destroy;
end;


//~~~~~~~~~~~~~~~~~~~~~~~~~~~
// FullScreen object
//~~~~~~~~~~~~~~~~~~~~~~~~~~~
constructor tFullScreen.Create;
var i: longword;
begin
Enabled:=false;

while EnumDisplaySettings(nil, ResolutionsCount, dm) do
 inc(ResolutionsCount);
SetLength(Resolutions, ResolutionsCount);
for i:=0 to ResolutionsCount-1 do
 begin
 EnumDisplaySettings(nil,i,dm);
 if dm.dmBitsPerPel>8 then
  begin
  Resolutions[i].Width:= dm.dmPelsWidth;
  Resolutions[i].Height:= dm.dmPelsHeight;
  Resolutions[i].BitsPerPixel:= dm.dmBitsPerPel;
  end;
 end;
end;

destructor tFullScreen.Destroy;
begin
if Enabled then Restore;
Finalize(Resolutions);
inherited destroy;
end;

function tFullScreen.GoFullScreen(res: tResolution; handle: HWND; hidecursor: boolean):boolean;
begin
result:=false;
if IsResAvailable(res) then
 begin
 WinHandle:=handle;
 if not Enabled then GetWindowRect(WinHandle,RC);
 dm.dmPelsWidth:=res.Width;
 dm.dmPelsHeight:=res.Height;
 dm.dmBitsPerPel:=res.BitsPerPixel;
 dm.dmFields:=DM_BITSPERPEL or DM_PELSWIDTH or DM_PELSHEIGHT;
 if ChangeDisplaySettings(dm,CDS_FULLSCREEN)=DISP_CHANGE_SUCCESSFUL then
  begin
  result:=true;
  if hidecursor then ShowCursor(False);
  end;
 if not Enabled then
  Enabled:=result;
 end
else beep;
end;

procedure tFullScreen.Restore;
begin
if Enabled then
 begin
 ChangeDisplaySettings(devmode(nil^), 0);
 SetWindowPos(WinHandle,HWND_TOPMOST,RC.left,RC.top,RC.right-RC.left,RC.bottom-RC.top,SWP_SHOWWINDOW);
 ShowCursor(True);
 Enabled:=false;
 end;
end;

function tFullScreen.IsResAvailable(res: tResolution):boolean;
var i:longword;
begin
result:=false;
for i:=0 to ResolutionsCount-1 do
 if (Resolutions[i].Width=res.Width) and
    (Resolutions[i].Height=res.Height) and
    (Resolutions[i].BitsPerPixel=res.BitsPerPixel) then
  begin
  result:=true;
  break;
  end;
end;

function tFullScreen.MakeResolution(Width, Height, BitsPerPixel: integer):tResolution;
begin
result.Width:=Width;
result.Height:=Height;
result.BitsPerPixel:=BitsPerPixel;
end;

end.
